home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro1.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-02  |  5KB  |  165 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 1
  27. }
  28. PROGRAM TED_INTRO_NR1;
  29. USES DOS,CRT;
  30.  
  31. VAR
  32.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  33.  CHARS          : ARRAY [' '..']'] OF POINTER;
  34.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  35.  F              : FILE;
  36.  B,ROW,COL      : BYTE;
  37.  X,Y,I          : INTEGER;
  38.  CH,K           : CHAR;
  39.  
  40. {───────────────────────────────────────────────────────────────────────────}
  41. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  42. ASM
  43.  MOV AX,0013H
  44.  INT 10H
  45. END;
  46. {───────────────────────────────────────────────────────────────────────────}
  47. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  48. ASM
  49.  MOV AX,0003H
  50.  INT 10H
  51. END;
  52. {───────────────────────────────────────────────────────────────────────────}
  53. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  54. ASM
  55.  MOV DX,3C8H
  56.  MOV AL,NR
  57.  OUT DX,AL
  58.  INC DX
  59.  MOV AL,R
  60.  OUT DX,AL
  61.  MOV AL,G
  62.  OUT DX,AL
  63.  MOV AL,B
  64.  OUT DX,AL
  65. END;
  66. {───────────────────────────────────────────────────────────────────────────}
  67. PROCEDURE PUTPIX(X,Y : INTEGER; C: BYTE); ASSEMBLER; { PLOT PIXEL AT (X,Y) }
  68. ASM
  69.  MOV   AX, 0A000H
  70.  MOV   ES, AX
  71.  MOV   AX, 320
  72.  MUL   Y
  73.  ADD   AX, X
  74.  MOV   DI, AX
  75.  MOV   AL, C
  76.  STOSB
  77. END;
  78. {───────────────────────────────────────────────────────────────────────────}
  79. PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
  80. BEGIN
  81.  ASSIGN(F,NAME+'.PAL');
  82.  RESET(F,1);
  83.  BLOCKREAD(F,PALETTE,768);
  84.  CLOSE(F);
  85.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  86. END;
  87. {───────────────────────────────────────────────────────────────────────────}
  88. PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
  89. VAR TX,TY: BYTE; CH: CHAR;
  90. BEGIN
  91.  ASSIGN(F,NAME+'.TED');
  92.  RESET(F,1);
  93.  SEEK(F,20);
  94.  WHILE NOT(EOF(F)) DO
  95.  BEGIN
  96.   BLOCKREAD(F,CH,1);
  97.   BLOCKREAD(F,TX,1);
  98.   BLOCKREAD(F,TY,1);
  99.   GETMEM(CHARS[CH],TX*TY);
  100.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  101.   BLOCKREAD(F,CHARS[CH]^,TX*TY);
  102.  END;
  103.  CLOSE(F);
  104. END;
  105. {───────────────────────────────────────────────────────────────────────────}
  106. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  107. VAR CH: CHAR;
  108. BEGIN
  109.  FOR CH:=' ' TO ']' DO
  110.  BEGIN
  111.   IF CHARSDATA[CH,3]=1 THEN
  112.   BEGIN
  113.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  114.    CHARSDATA[CH,3]:=0;
  115.   END;
  116.  END;
  117. END;
  118. {───────────────────────────────────────────────────────────────────────────}
  119. PROCEDURE PUTIT(X,Y: INTEGER; CH: CHAR); { DRAW ONE CHAR }
  120. VAR XR,YR,AX,AY: BYTE;
  121. BEGIN
  122.  XR:=CHARSDATA[CH,1];
  123.  YR:=CHARSDATA[CH,2];
  124.  FOR AY:=1 TO YR DO
  125.  FOR AX:=1 TO XR DO
  126.  BEGIN
  127.   B:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(AY-1)*XR+AX-1];
  128.   IF B>0 THEN PUTPIX(X+AX-1,Y+AY-1,B);
  129.  END;
  130. END;
  131. {───────────────────────────────────────────────────────────────────────────}
  132. PROCEDURE WRITEXY(X,Y: INTEGER; S: STRING); { WRITE A STRING ON SCREEN }
  133. VAR ABSX,ABSY: INTEGER; NR: BYTE;
  134. BEGIN
  135.  ABSX:=X; ABSY:=Y;
  136.  FOR NR:=1 TO LENGTH(S) DO
  137.  IF S[NR] IN [' '..']'] THEN
  138.  BEGIN
  139.   IF S[NR]=' ' THEN INC(ABSX,CHARSDATA[S[NR+1],1]+1)
  140.   ELSE BEGIN
  141.   PUTIT(ABSX,ABSY,S[NR]);
  142.   INC(ABSX,CHARSDATA[S[NR],1]+1);
  143.   END;
  144.  END;
  145. END;
  146. {───────────────────────────────────────────────────────────────────────────}
  147.  
  148.  
  149.  
  150. BEGIN
  151.  INITVGA;
  152.  LOADPAL('FONT018');
  153.  LOADTED('FONT018');
  154.  
  155.  WRITEXY(0,0,  'WADDA FUQ IS THAT?');
  156.  WRITEXY(0,30, 'ITS ONLY SMALL');
  157.  WRITEXY(0,60, 'EXAMPLE HOW TO');
  158.  WRITEXY(0,90, 'SHOW CHARS ON');
  159.  WRITEXY(0,120,'THE SCREEN');
  160.  
  161.  READKEY;
  162.  
  163.  DONETED;
  164.  CLOSEVGA;
  165. END.